// From hubfs: http://cs.hubfs.net/blogs/hell_is_other_languages/archive/2008/02/17/4892.aspx
#light

open System  
open System.Threading
  
type Lock<'a> = Lock of (obj -> 'a)

module Lock =
  let apply (Lock f) lock = f lock
  
  let mreturn x = Lock (fun lock -> x)
  
  let bind m f = Lock (fun lock -> apply (f (apply m lock)) lock)
  
  let run lock m =
    let lock = box lock
    Monitor.Enter(lock)
    try apply m lock
    finally Monitor.Exit(lock)

  let tryRun lock (timeout : int) m =
    let lock = box lock
    if Monitor.TryEnter(lock, timeout)
    then try Some (apply m lock)
         finally Monitor.Exit(lock)
    else None
      
  let wait = Lock (fun lock -> Monitor.Wait(lock) |> ignore)
  
  let tryWait (timeout : int) = Lock (fun lock -> Monitor.Wait(lock, timeout))
  
  let pulse = Lock (fun lock -> Monitor.Pulse(lock))
  
  let pulseAll = Lock (fun lock -> Monitor.PulseAll(lock))
  
  let tryWith m cth = Lock (fun lock -> try apply m lock with exc -> apply (cth exc) lock)
  
  let tryFinally m fin = Lock (fun lock -> try apply m lock finally fin ())

  let liftM f m = bind m (f >> mreturn)
  
  type Builder () =
    member b.Return(x) = mreturn x
    member b.Bind(m, f) = bind m f
    member b.TryWith(m, cth) = tryWith m cth
    member b.TryFinally(m, fin) = tryFinally m fin
    
    member b.Let(x, f) = f x
    member b.Delay(f) = Lock (fun lock -> apply (f ()) lock)
    member b.Zero() = mreturn ()
    member b.Combine(m1, m2) = bind m1 (fun () -> m2)
    
    member b.BindUsing(m, f) = bind m (fun (x : #IDisposable) -> tryFinally (f x) (fun () -> x.Dispose()))
    member b.Using(x : #IDisposable, f) = tryFinally (f x) (fun () -> x.Dispose())

    member b.While(p, m) = Lock (fun lock -> while p () do apply m lock)
    member b.For(xs, f) = Lock (fun lock -> xs |> Seq.iter (fun x -> apply (f x) lock))
    
  let lock = Builder()
  
 
open Lock  
open System.Collections.Generic

let enqueue (q : Queue<_>) x = 
  lock { if q.Count = 0 then return! pulseAll
         return q.Enqueue(x) }
   
let dequeue (q : Queue<_>) = 
  lock { while q.Count = 0 do return! wait
         return q.Dequeue() }

let myLock = new obj()

let move q1 q2 = 
  lock { let! x = dequeue q1 
         do! enqueue q2 x
         return x } |> run myLock
